home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch11 / LeastSq2.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-12  |  5KB  |  155 lines
  1. VERSION 5.00
  2. Begin VB.Form frmLeastSq2 
  3.    Caption         =   "LeastSq2"
  4.    ClientHeight    =   5310
  5.    ClientLeft      =   2085
  6.    ClientTop       =   615
  7.    ClientWidth     =   4830
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   5310
  11.    ScaleWidth      =   4830
  12.    Begin VB.CommandButton cmdGo 
  13.       Caption         =   "Go"
  14.       Default         =   -1  'True
  15.       Enabled         =   0   'False
  16.       Height          =   375
  17.       Left            =   2040
  18.       TabIndex        =   1
  19.       Top             =   4920
  20.       Width           =   615
  21.    End
  22.    Begin VB.PictureBox picCanvas 
  23.       AutoRedraw      =   -1  'True
  24.       Height          =   2535
  25.       Left            =   120
  26.       ScaleHeight     =   165
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   229
  29.       TabIndex        =   0
  30.       Top             =   120
  31.       Width           =   3495
  32.    End
  33. Attribute VB_Name = "frmLeastSq2"
  34. Attribute VB_GlobalNameSpace = False
  35. Attribute VB_Creatable = False
  36. Attribute VB_PredeclaredId = True
  37. Attribute VB_Exposed = False
  38. Option Explicit
  39. Private NumPts As Integer
  40. Private PtX() As Single
  41. Private PtY() As Single
  42. ' Compute the a, b, and c values for quadratic least squares.
  43. Private Sub GetLeastSquaresValues(X() As Single, Y() As Single, ByRef a_value As Single, ByRef b_value As Single, ByRef c_value As Single)
  44. Dim num_points As Integer
  45. Dim A As Single
  46. Dim B As Single
  47. Dim C As Single
  48. Dim D As Single
  49. Dim E As Single
  50. Dim F As Single
  51. Dim G As Single
  52. Dim x2 As Single
  53. Dim x3 As Single
  54. Dim x4 As Single
  55. Dim C2BE As Single
  56. Dim E2CN As Single
  57. Dim BDAF As Single
  58. Dim CFBG As Single
  59. Dim ACB2 As Single
  60. Dim denom As Single
  61. Dim i As Integer
  62.     num_points = UBound(X)
  63.     ' Compute the sums.
  64.     For i = 1 To num_points
  65.         x2 = PtX(i) * PtX(i)
  66.         x3 = x2 * PtX(i)
  67.         x4 = x2 * x2
  68.         A = A + x4
  69.         B = B + x3
  70.         C = C + x2
  71.         D = D + PtY(i) * x2
  72.         E = E + PtX(i)
  73.         F = F + PtY(i) * PtX(i)
  74.         G = G + PtY(i)
  75.     Next i
  76.     ' Compute the quadratic parameters.
  77.     C2BE = C * C - B * E
  78.     E2CN = E * E - C * num_points
  79.     BDAF = B * D - A * F
  80.     CFBG = C * F - B * G
  81.     ACB2 = A * C - B * B
  82.     denom = (B * C - A * E) * C2BE - _
  83.             (C * E - B * num_points) * (B * B - A * C)
  84.     a_value = _
  85.         ((C * D - B * F) * E2CN - (E * F - C * G) * C2BE) / _
  86.         (ACB2 * E2CN + C2BE * C2BE)
  87.     b_value = _
  88.         (CFBG * (B * C - A * E) - BDAF * (C * E - B * num_points)) / _
  89.         denom
  90.     c_value = _
  91.         (BDAF * (C * C - B * E) + CFBG * ACB2) / _
  92.         denom
  93. End Sub
  94. Private Sub Form_Resize()
  95. Dim hgt As Single
  96.     cmdGo.Move (ScaleWidth - cmdGo.Width) / 2, ScaleHeight - cmdGo.Height
  97.     hgt = cmdGo.Top - 30
  98.     If hgt < 120 Then hgt = 120
  99.     picCanvas.Move 0, 0, ScaleWidth, hgt
  100. End Sub
  101. ' Add this point to the list of points.
  102. Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  103. Const GAP = 2
  104.     ' If this is the first point, erase the screen.
  105.     If NumPts < 1 Then picCanvas.Cls
  106.     ' Record the new point.
  107.     NumPts = NumPts + 1
  108.     ReDim Preserve PtX(1 To NumPts)
  109.     ReDim Preserve PtY(1 To NumPts)
  110.     PtX(NumPts) = X
  111.     PtY(NumPts) = Y
  112.     ' Display the point.
  113.     picCanvas.Line (X - GAP, Y - GAP)-(X + GAP, Y + GAP), , BF
  114.     ' If NumPts >= 2, enable the Go button.
  115.     If NumPts >= 2 Then cmdGo.Enabled = True
  116. End Sub
  117. ' Draw the least squares fit curve.
  118. Private Sub cmdGo_Click()
  119.     cmdGo.Enabled = False
  120.     DrawCurve
  121.     ' Prepare to get a new set of points.
  122.     NumPts = 0
  123. End Sub
  124. ' Draw the least squares line.
  125. Private Sub DrawCurve()
  126. Dim A As Single
  127. Dim B As Single
  128. Dim C As Single
  129. Dim x1 As Single
  130. Dim x2 As Single
  131. Dim i As Integer
  132. Dim X As Single
  133. Dim dx As Single
  134.     ' Get the parameters for the quadratic.
  135.     GetLeastSquaresValues PtX, PtY, A, B, C
  136.     ' Find the minimum and maximum X values.
  137.     x1 = PtX(1) ' This will be the minimum X value.
  138.     x2 = x1     ' This will be the maximum X value.
  139.     For i = 2 To NumPts
  140.         If x1 > PtX(i) Then x1 = PtX(i)
  141.         If x2 < PtX(i) Then x2 = PtX(i)
  142.     Next i
  143.     ' Draw the curve.
  144.     picCanvas.CurrentX = x1
  145.     picCanvas.CurrentY = A * x1 * x1 + B * x1 + C
  146.     ' Make dx = 1 pixel.
  147.     dx = picCanvas.ScaleX(1, vbPixels, picCanvas.ScaleMode)
  148.     X = x1 + dx
  149.     Do While X < x2
  150.         picCanvas.Line -(X, A * X * X + B * X + C)
  151.         X = X + dx
  152.     Loop
  153.     picCanvas.Line -(x2, A * x2 * x2 + B * x2 + C)
  154. End Sub
  155.